home *** CD-ROM | disk | FTP | other *** search
- ⓪ MODULE FAT;⓪ (*$A+*)⓪ ⓪ (*⓪!* Zeigt FAT an, korrigiert ggf.⓪!*)⓪ ⓪ FROM InOut IMPORT WriteCard, WriteLn, ReadCard, WriteString;⓪ IMPORT InOut;⓪ ⓪ FROM SYSTEM IMPORT ADDRESS, ADR, BYTE, ASSEMBLER;⓪ ⓪ FROM BIOS IMPORT GetBPB, RWAbs, Read, Write, BPBPtr, ControlKey, GetKBShift;⓪ ⓪ FROM Block IMPORT Copy;⓪ ⓪ FROM Storage IMPORT ALLOCATE, DEALLOCATE;⓪ ⓪ FROM Strings IMPORT String, Relation,⓪4Empty, Append, Assign, Concat, Length, PosLen, Delete,⓪4Compare;⓪ ⓪ IMPORT FastStrings;⓪ ⓪ FROM Lists IMPORT List,⓪2ResetList, PrevEntry, DeleteList, CreateList, AppendEntry,⓪2NoOfEntries, RemoveEntry, CurrentEntry, InsertEntry,⓪2NextEntry;⓪ ⓪ FROM Directory IMPORT PathExists, DirEntry, FileAttr, FileAttrSet, DirQuery;⓪ ⓪ FROM FileNames IMPORT SplitPath, ConcatPath;⓪ ⓪ FROM StrConv IMPORT CardToStr;⓪ ⓪ FROM GrafBase IMPORT Point, Rectangle,⓪5Rect;⓪ ⓪ FROM GEMGlobals IMPORT GemChar, MouseButton, MButtonSet, SpecialKeySet, MaxStr;⓪ ⓪ FROM AESEvents IMPORT RectEnterMode, Event;⓪ ⓪ FROM EventHandler IMPORT EventProc,⓪9HandleEvents;⓪ ⓪ FROM WindowLists IMPORT WindowList, NoWindowList, DetectModeWL, AttributesWL,⓪8AttributeWL, MaxWindowWL, CenterWindowWL, ErrorStateWL,⓪8ReplaceEntryWL, CreateWL, DeleteWL, SetListWL,⓪8GetListWL,⓪8ViewLineWL, ShowWindowWL, HideWindowWL, DetectWindowWL,⓪8SetEntryAttributesWL, EntryAttributesWL, StateWL;⓪ ⓪ ⓪ TYPE PtrFAT = ADDRESS;⓪ ⓪ ⓪ TYPE PtrWEnv = POINTER TO RECORD⓪4opened: BOOLEAN;⓪4drive: CARDINAL;⓪4oldFat, fat: PtrFAT;⓪4bpb: BPBPtr;⓪4fat12Bit: BOOLEAN;⓪4wl: WindowList;⓪2END;⓪(⓪(Entry = POINTER TO DirEntry;⓪ ⓪ ⓪ VAR Success,⓪(Quit,⓪(VoidO : BOOLEAN;⓪(PrevCluster: CARDINAL;⓪ ⓪ ⓪ FORWARD EntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪ ⓪ FORWARD CloseWList (wl: WindowList; env: ADDRESS);⓪ ⓪ FORWARD OpenFolder (wl: WindowList; env, entry: ADDRESS; selMode: LONGCARD);⓪ ⓪ ⓪ VAR CurrList : List;⓪ ⓪ TYPE FATProc = PROCEDURE (CARDINAL);⓪"⓪ PROCEDURE FATEntry (fat: PtrFAT; fat12Bit: BOOLEAN; cluster: CARDINAL): CARDINAL;⓪"⓪"TYPE PtrByte = POINTER TO BYTE;⓪ ⓪"VAR pb: ADDRESS;⓪"⓪"BEGIN⓪$IF fat12Bit THEN⓪&pb:= ADDRESS(fat) + LONG (cluster) DIV 2 * 3;⓪&IF ODD (cluster) THEN⓪(RETURN (ORD(PtrByte(pb+1)^) DIV 16) + ORD(PtrByte(pb+2)^) * 16⓪&ELSE⓪(RETURN ORD(PtrByte(pb)^) + (ORD(PtrByte(pb+1)^) MOD 16) * 256⓪&END⓪$ELSE⓪&pb:= ADDRESS(fat) + LONG (cluster) * 2;⓪&RETURN ORD(PtrByte(pb)^) + ORD(PtrByte(ADDRESS(pb)+1)^) * 256;⓪$END;⓪"END FATEntry;⓪"⓪ PROCEDURE SetFATEntry (fat: PtrFAT; fat12Bit: BOOLEAN; cluster, next: CARDINAL);⓪"⓪"TYPE PtrByte = POINTER TO BYTE;⓪ ⓪"VAR pb: ADDRESS;⓪"⓪"BEGIN⓪$IF fat12Bit THEN⓪&IF next > 4095 THEN⓪(HALT⓪&ELSE⓪(pb:= ADDRESS(fat) + LONG (cluster) DIV 2 * 3;⓪(ASSEMBLER⓪*MOVE.L pb(A6),A0⓪*MOVE next(A6),D0⓪*MOVE cluster(A6),D1⓪*BTST #0,D1⓪*BNE isodd⓪*MOVE.B D0,(A0)⓪*LSR.W #8,D0⓪*MOVE.B 1(A0),D1⓪*ANDI.B #$F0,D1⓪*OR.B D0,D1⓪*MOVE.B D1,1(A0)⓪*BRA ende⓪(isodd⓪*MOVE.B D0,D1⓪*LSL.W #4,D1⓪*MOVE.B 1(A0),D2⓪*ANDI.B #$0F,D2⓪*OR.B D2,D1⓪*MOVE.B D1,1(A0)⓪*LSR.W #4,D0⓪*MOVE.B D0,2(A0)⓪(ende⓪(END⓪&END⓪$ELSE⓪&pb:= ADDRESS(fat) + LONG (cluster) * 2;⓪&ASSEMBLER⓪(MOVE next(A6),D0⓪(MOVE.L pb(A6),A0⓪(ROR.W #8,D0⓪(MOVE.W D0,(A0)⓪&END⓪$END;⓪"END SetFATEntry;⓪ ⓪ PROCEDURE ReadFAT (wEnvPtr: PtrWEnv): BOOLEAN;⓪"VAR i: CARDINAL; l: LONGINT; b: BOOLEAN;⓪"BEGIN⓪$WITH wEnvPtr^ DO⓪&b:= PathExists (CHR(drive+ORD("A")));⓪&bpb:= GetBPB (drive);⓪&WITH bpb^ DO⓪(fat12Bit:= bflags = 0;⓪(IF fat12Bit THEN⓪*WriteString ('12 Bit FAT');⓪(ELSE⓪*WriteString ('16 Bit FAT')⓪(END;⓪(WriteLn;⓪ ⓪(ALLOCATE (fat, fsiz * recsiz);⓪(ALLOCATE (oldFat, fsiz * recsiz);⓪(IF (fat = NIL) OR (oldFat = NIL) THEN⓪*WriteLn; WriteString ('Out of memory!'); WriteLn;⓪*RETURN FALSE⓪(END;⓪ ⓪(l:= RWAbs (Read, fat, fsiz, fatrec, drive);⓪(IF l # 0L THEN⓪*WriteLn; WriteString ('Read error!'); WriteLn;⓪*RETURN FALSE⓪(END;⓪(Copy (fat, fsiz*recsiz, oldFat)⓪&END;⓪$END;⓪$RETURN TRUE⓪"END ReadFAT;⓪ ⓪ PROCEDURE WriteFAT (wEnvPtr: PtrWEnv): BOOLEAN;⓪"VAR i: CARDINAL; l: LONGINT; b: BOOLEAN;⓪"BEGIN⓪$WITH wEnvPtr^ DO⓪&WITH bpb^ DO⓪(l:= RWAbs (Write, fat, fsiz, fatrec, drive);⓪(IF l # 0L THEN⓪*WriteLn; WriteString ('Write error!'); WriteLn;⓪*RETURN FALSE⓪(END;⓪(Copy (fat, fsiz*recsiz, oldFat)⓪&END;⓪$END;⓪$RETURN TRUE⓪"END WriteFAT;⓪ ⓪ PROCEDURE InsertEntryInCurr (n: CARDINAL);⓪"VAR error: BOOLEAN;⓪"BEGIN⓪$(*⓪$WriteCard (cluster, 5);⓪$WriteString (': ');⓪$WriteCard (next, 5);⓪$WriteLn;⓪$*)⓪$AppendEntry (CurrList, LONG(n)+65536 (* vermeidet den Wert 0 *), error);⓪$IF error THEN HALT END;⓪"END InsertEntryInCurr;⓪"⓪ PROCEDURE QueryFAT (wEnvPtr: PtrWEnv; out: FATProc);⓪"VAR i: CARDINAL;⓪"BEGIN⓪$WITH wEnvPtr^ DO⓪&FOR i:= 0 TO bpb^.numcl DO⓪(out (i)⓪&END⓪$END;⓪"END QueryFAT;⓪ ⓪ PROCEDURE newList (wEnvPtr: PtrWEnv);⓪ ⓪"VAR res : INTEGER;⓪(wildName: String;⓪(error: BOOLEAN;⓪ ⓪"BEGIN⓪$CreateList (CurrList, error);⓪$IF error THEN HALT END;⓪$IF ReadFAT (wEnvPtr) THEN⓪&QueryFAT (wEnvPtr, InsertEntryInCurr);⓪&SetListWL (wEnvPtr^.wl, CurrList, EntryToStr, CloseWList, OpenFolder,⓪1wEnvPtr, 30, CHR(wEnvPtr^.drive+ORD("A")));⓪&IF StateWL (wEnvPtr^.wl) # okWL THEN⓪(WriteString ('Error setting list!'); WriteLn⓪&END⓪$END⓪"END newList;⓪ ⓪ PROCEDURE killList (wEnvPtr: PtrWEnv);⓪ ⓪"VAR l : List;⓪(entry : Entry;⓪ ⓪"BEGIN⓪$GetListWL (wEnvPtr^.wl, l);⓪$⓪$ResetList (l);⓪$entry := PrevEntry (l);⓪$WHILE entry # NIL DO⓪&RemoveEntry (l, VoidO);⓪&(*⓪&DISPOSE (entry);⓪&*)⓪&entry := CurrentEntry (l);⓪$END;⓪$DeleteList (l, VoidO);⓪$DEALLOCATE (wEnvPtr^.fat, 0);⓪$IF VoidO THEN HALT END;⓪"END killList;⓪"⓪ ⓪ PROCEDURE CloseWList (wl: WindowList; env: ADDRESS);⓪ ⓪"VAR wEnv: PtrWEnv;⓪(i, j,⓪(len : INTEGER;⓪(folderName: String;⓪ ⓪"BEGIN⓪$wEnv := PtrWEnv (env);⓪$WITH wEnv^ DO⓪&killList (wEnv);⓪&HideWindowWL (wl);⓪&opened:= FALSE⓪$END;⓪"END CloseWList;⓪ ⓪ ⓪ PROCEDURE EntryToStr (entry, env: ADDRESS; VAR str: MaxStr);⓪"⓪"VAR next, next2, cluster: CARDINAL;⓪"⓪"PROCEDURE apnd (n: CARDINAL);⓪$BEGIN⓪&IF n = $FFF THEN⓪(Append ("<EOF>", str, VoidO)⓪&ELSIF n = $FF9 THEN⓪(Append ("<DIR>", str, VoidO)⓪&ELSE⓪(Append (CardToStr (n,5), str, VoidO);⓪&END;⓪$END apnd;⓪"⓪"PROCEDURE apnd2 (n: CARDINAL);⓪$BEGIN⓪&IF n > $FF7 THEN⓪(Append (" ", str, VoidO)⓪&ELSE⓪(IF n <= cluster THEN⓪*Append (' < ', str, VoidO);⓪(ELSIF n # cluster + 1 THEN⓪*Append (' ~ ', str, VoidO);⓪(ELSE⓪*Append (' ', str, VoidO);⓪(END⓪&END;⓪$END apnd2;⓪"⓪"VAR fatDesc: PtrWEnv;⓪"⓪"BEGIN⓪$cluster:= SHORT (LONGCARD(entry) MOD 65536);⓪$fatDesc:= env;⓪$WITH fatDesc^ DO⓪&next:= FATEntry (fat, fat12Bit, cluster);⓪&next2:= FATEntry (oldFat, fat12Bit, cluster);⓪&Concat (CardToStr (cluster,6), ': ', str, VoidO);⓪&apnd (next);⓪&apnd2 (next);⓪&IF next2 # next THEN⓪(Append ('(', str, VoidO);⓪(apnd (next2);⓪(Append (')', str, VoidO);⓪&END;⓪&Append (' ', str, VoidO);⓪$END⓪"END EntryToStr;⓪ ⓪ PROCEDURE OpenFolder (wl: WindowList; entry, env: ADDRESS; clicks: LONGCARD);⓪ ⓪"VAR attrs : AttributesWL;⓪(cluster, next: CARDINAL;⓪(fatDesc: PtrWEnv;⓪ ⓪"BEGIN⓪$fatDesc:= env;⓪$cluster:= SHORT (LONGCARD(entry) MOD 65536);⓪$next:= FATEntry (fatDesc^.fat, fatDesc^.fat12Bit, cluster);⓪$IF clicks = 2 THEN⓪&PrevCluster:= cluster;⓪&WriteString ('View cluster '); WriteCard (next, 0); WriteLn;⓪&ViewLineWL (wl, next+1);⓪$ELSIF clicks = 1 THEN⓪&(*⓪(attrs:= EntryAttributesWL (wl, entry);⓪(IF selectedWL IN attrs THEN⓪*EXCL (attrs, selectedWL)⓪(ELSE⓪*INCL (attrs, selectedWL)⓪(END;⓪(SetEntryAttributesWL (wl, entry, attrs);⓪&*)⓪&WriteString ('Cluster '); WriteCard (cluster, 0);⓪&IF ControlKey IN GetKBShift() THEN⓪((* Folgecluster einsetzen *)⓪(next:= cluster + 1;⓪(WriteString (': '); WriteCard (next, 0); WriteLn;⓪&ELSE⓪((* Cluster manuell bestimmen *)⓪(WriteString ('? '); ReadCard (next);⓪&END;⓪&SetFATEntry (fatDesc^.fat, fatDesc^.fat12Bit, cluster, next);⓪&ReplaceEntryWL (wl, entry, entry, TRUE)⓪$END⓪"END OpenFolder;⓪ ⓪ ⓪ VAR FAT : PtrWEnv;⓪ ⓪ ⓪ PROCEDURE KeyHdler (VAR ch: GemChar; VAR k: SpecialKeySet): BOOLEAN;⓪"VAR c: CHAR; i: CARDINAL;⓪"BEGIN⓪$IF CAP (ch.ascii) = 'Q' THEN⓪&Quit := TRUE⓪$ELSE⓪&WITH FAT^ DO⓪(IF ~opened THEN⓪*IF (CAP (ch.ascii) >= 'A') AND (CAP (ch.ascii) <= 'P') THEN⓪,opened:= TRUE;⓪,drive:= ORD (CAP(ch.ascii)) - ORD ("A");⓪,newList (FAT);⓪,ShowWindowWL (wl);⓪*END;⓪(ELSE⓪*IF ch.ascii = CHR(13) THEN (* Return *)⓪,WriteString ('View cluster '); WriteCard (PrevCluster, 0); WriteLn;⓪,ViewLineWL (FAT^.wl, PrevCluster+1);⓪*ELSIF CAP(ch.ascii) = 'O' THEN⓪,ShowWindowWL (wl);⓪*ELSIF CAP(ch.ascii) = 'C' THEN⓪,HideWindowWL (wl);⓪*ELSIF CAP(ch.ascii) = 'W' THEN⓪,WriteString ('Write FAT? (Y/N) ');⓪,REPEAT⓪.InOut.Read (c)⓪,UNTIL (CAP(c)='Y') OR (CAP(c)='J') OR (CAP(c)='N');⓪,IF (CAP(c) # 'N') & WriteFAT (FAT) THEN⓪.WriteString ('FAT Written'); WriteLn⓪,END;⓪,HideWindowWL (wl);⓪*ELSIF CAP(ch.ascii) = '@' THEN⓪,(* ganze FAT mit einem File belegen *)⓪,FOR i:= 2 TO FAT^.bpb^.numcl-1 DO⓪.SetFATEntry (FAT^.fat, FAT^.fat12Bit, i, i+1);⓪,END;⓪,SetFATEntry (FAT^.fat, FAT^.fat12Bit, FAT^.bpb^.numcl, $FFF);⓪,HideWindowWL (wl);⓪*END⓪(END⓪&END⓪$END;⓪$RETURN FALSE⓪"END KeyHdler;⓪ ⓪ PROCEDURE ButHdler (clicks: CARDINAL; loc: Point; buts: MButtonSet;⓪4keys: SpecialKeySet): BOOLEAN;⓪ ⓪"VAR wl : WindowList;⓪(entry,⓪(env : ADDRESS;⓪ ⓪"BEGIN⓪$DetectWindowWL (FAT^.wl, 0, loc, selectWL, clicks, wl, entry, env, VoidO);⓪$RETURN FALSE⓪"END ButHdler;⓪ ⓪ VAR Worker: ARRAY [0..1] OF EventProc;⓪ ⓪ BEGIN⓪"NEW (FAT);⓪"FAT^.opened:= FALSE;⓪"CreateWL (FAT^.wl, TRUE, Rect (CenterWindowWL, CenterWindowWL,⓪CMaxWindowWL, MaxWindowWL));⓪"IF StateWL (FAT^.wl) = okWL THEN⓪$⓪$WriteString ('Q: Quit');⓪$WriteLn;⓪$⓪$Worker[0].event := keyboard;⓪$Worker[0].keyHdler := KeyHdler;⓪$Worker[1].event := mouseButton;⓪$Worker[1].butHdler := ButHdler;⓪$Quit:= FALSE;⓪$REPEAT⓪&HandleEvents (2, MButtonSet{msBut1}, MButtonSet{msBut1},⓪4lookForEntry, Rect (0,0,0,0),⓪4lookForEntry, Rect (0,0,0,0),⓪40L,⓪4Worker, 0);⓪$UNTIL Quit;⓪$⓪"END;⓪ END FAT.⓪ ə
- (* $FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$000023DC$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23C$FFEDB23CÇ$000023E9T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00002444$00002407$0000204C$00002417$FFED4E26$00002421$FFED4E26$000023DF$FFED4E26$000023E9$000023B8$0000243C$000023AB$00002398$0000234C$0000245C¿üé*)
-
